Mac Mania 2/MacMania 2.toast/Demo's/Tools&Utilities/Programming/MacStarter Pascal 1.0/xWindows definition files/xControlDecoration.p

Text File | 1993-05-13 | 26.7 KB | 902 lines | [TEXT/PJMM]

unit xControlDecoration;

{ "Controls" in Macintosh lingo refer to things like scroll bars, buttons, check }
{ boxes and radio buttons.   This unit implements all these classes of controls as }
{ xWindowDecorations.  }

interface

uses
    xWindow;

type
    xControlDecoration = object(xWindowDecoration)
             { An abstract class providing the common protocol for all control decorations }
             { NOTE: among the useful stuff inherited from xWindowDecoration is the }
             { instance variable  itsWindow, which tells you which xWindow the control }
             { is installed into. }
            theControl: controlHandle;  { Macintosh control data }
            trueWidth, trueHeight: integer;  { actual size of the control }
            procedure makeInactive;
             { "Grays out" the control , so clicking on it will have no effect }
            procedure makeActive;
            { makes a grayed out control active again }
            procedure init;  { This and remaining procedures just redefine procedures from }
            override;              { class xWindowDecoration (in unit xWindow.p) }
            procedure kill;
            override;
            procedure doActivate (active: boolean);
            override;
            procedure adjustSize;
            override;
            procedure show;
            override;
            procedure hide;
            override;
        end;

    xButton = object(xControlDecoration)
          { A push button control.  When the user clicks on the button, the procedure }
          { HandleClick is called.  In this class, HandleClick does nothing.  To make it }
          { do something, you should define a subclass in which you override the }
          { HandleClick method.  You do not necessarily have to do this for each button }
          { you want, since you can determine easily which button was pressed (by }
          { refering to the variable SELF) and which window it was in. }
            procedure SetUp (win: xWindow;
                                        name: string;
                                        theLeft, theTop, theWidth, theHeight: integer);
          { installes a button with the given name in the given window.  The name is }
          { displayed on the button.  If the character "\" occurs in the name, it is treated }
          { as a line feed, allowing you to have multi-line names.   The parameters }
          { theLeft,...,theHeight determine the size and location of the button, as }
          { discussed in the comments on procedure xWindowDecoration.Install in }
          { unit xWindopw.p.  However, if the resulting size is not large enough to }
          { display the button's name, the size will be increased as necessary .  (Thus, }
          { for example, to get a button in which the name just fits nicely, you can }
          { pass valued of 1 for theWidth and theHeight.) }
            procedure HandleClick;
          { Called when the user clicks on the button; by default, does nothing }
            procedure Press;
          { simulates pressing the button, exactly as if the user had clicked on it.  This  }
          { includes briefly hiliting the button and calling HandleClick.  This will have }
          { no effect, of course, if the button is grayed out. }
            procedure SetName (name: string);
          { Change the name of the button.  This might force the size of th button to increase, }
          { if there is not room for the new name in the current button.  Note,  however, that }
          { calling this procedure will never decrease the size of the button. }
            procedure doClick (localPt: point;
                                        modifiers: longint);  { handles user click }
            override;
        end;

    xDefaultButton = object(xButton)
            { Similar to a button except: (1) A thick outline is drawn around the button, and }
            { (2) when the user presses Return or Enter, it will have the same effect as }
            { clicking on this button.  You should not have more than one of these in a window }
            { If you do, a Return or Enter will press the one most recently installed. }
            { All comments about xButtons apply. }
            procedure init;
            override;
            procedure adjustSize;
            override;
            procedure doCr (ch: char);
            override;
            procedure doDraw;
            override;
        end;

    xScrollBar = object(xControlDecoration)
            { A standard scroll bar.  }
            linesPerPage: integer;  { number of units by which the scroll bar will scroll }
                                            { when the user clicks in the gray area of the scroll bar }
            savedMax, savedVal: integer;  { save value while the scroll bar is  inactive }
            procedure SetUp (win: xWindow;
                                        theLeft, theTop, theWidth, theHeight: integer);
            { Install a scroll bar in the specified window.  The meanings of the other }
            { parameters define the location and size of the scroll bar, as described in }
            { the comments on procedure xWindowDecoration.Install in unit xWindow.p. }
            {  Several additional comments apply to scroll bars:  Ordinarily, you will }
            { set either the height or the width of the scroll bar to 15 (although some }
            { other values are useable, such as 10 and 30).  The other dimension should }
            { be at least four times as large.   When the scroll bar is installed or resized, }
            { a restriction that both dimensions be >= 10, and that one dimension be }
            { at least 4 times as large as the other is enforced, and the size will be }
            { changed if necesary.  Whether the scroll bar is vertical or horizontal depends }
            { only on which dimension is greater. }
            procedure HandleScroll (changeInVal: integer);
            { This is called whenever the user changes the value of the scroll bar.  It is }
            { called repeatedly if the user holds down the mouse.  The parameter specified }
            { the change in the scroll value, but you can easily get the current value if }
            { you like, by calling GetVal.  The default method defined for this class does }
            { nothing.  You can override it if you need to in a subclass. }
            procedure SetMax (newMax: integer);
            procedure SetVal (newVal: integer);
            function GetVal: integer;
            function GetMax: integer;
            { These four procedures are used to set and inspect the scroll value and the }
            { maximum scroll value.  The value can go from 0 to the specified maximum. }
            { If the maximum is 0, then the scroll bar is essentially useless; you will }
            { set a maximum value immediately after calling SetUp.  NOTE:  SetVal }
            { does NOT call HandleScroll. }
            procedure SetLinesPerPage (lines: integer);
            { Determines how many units the scroll bar scrolls when the user clicks in }
            { the scroll bar's gray area;  initialized to 1. }
            procedure makeActive;  { remaining procedures just override inherited }
            override;                           { methods, as appropriate for scroll bars. }
            procedure makeInactive;
            override;
            procedure doClick (localPt: point;
                                        modifiers: longint);
            override;
            procedure adjustSize;
            override;
        end;

    xCheckBox = object(xControlDecoration)
           { Implements a Check box, which has two states, checked and unchecked; }
           { the user toggles between these states by clicking on the box, or on its }
           { name, which is displayed to the right of the box. }
            procedure SetUp (win: xWindow;
                                        name: string;
                                        theLeft, theTop: integer);
           { Installs the chek box at the given position.  The size of this control cannot }
           { be changed.  The name is displayed to the right of the box.  If the name includes }
           { the character "\", it is interpreted as a line feed, allowing you to have multi- }
           { line box labels.  The box is unchecked when is is first installed. }
            procedure check;
           { set the box to the Checked state }
            procedure unCheck;
           { set the box the Unchecked state }
            function checked: boolean;
           { returns TRUE if the box is Checked, FALSE if not }
            procedure HandleClick;
           { Called when the user clicked on the box; ordinarily, nothing needs to be done, }
           { and that is what this default method does.  You can call function checked when }
           { you need to determine if the box is checked.  However, you can override this }
           { method when you want to react immediately to the user's clicking the box. }
            procedure doClick (localPt: point;
                                        modifiers: longint);  { react to user click }
            override;
        end;

    xRadioGroup = object
           { A radio button is similar to a check box, in that it can have two states, but it }
           { is represented by a circle that can be filled in or not.  Radio buttons should }
           { always occur in groups of two or more, and exactly one of the buttons in }
           { a group should be on at any given time. }
           { This class implements vertically arranged groups of up to 10 radio buttons. }
           { Note that if you want to activate and inactivate individual buttons, you will }
           { have to send messages to them individually. }
            theButtons: array[1..10] of xRadioButton;   { the buttons in the group }
            buttonCount: 1..10;   { number of buttons }
            selected: 1..10;   { which of the buttons is currently selected }
            procedure SetUp (win: xWindow;
                                        name: string;
                                        theLeft, theTop: integer);
           { Installs a radio group in the window at the specified location; it is not possible }
           { to change the size of a radio group.  The "name" parameter must contain the }
           { labels for all the buttons in the group, separated by backslashes (\). }
           { Initially, button 1 is selected. }
            procedure select (buttonNum: integer);
           { Select the specified button in the group. Note that although the user cannot }
           { select a grayed out button by clicking on it, you can select it with this procedure. }
            function selectedButton: integer;
           { returns the number of the button in the group that is currently selected. }
            procedure HandleChangeOfSelection;
           { Called when the user changes the selected button.  This default method }
           { does nothing, which is usually the desired behaviour. }
            procedure hide;
           { Hides the entire group of button }
            procedure show;
           { Shows all the buttons }
        end;

    xRadioButton = object(xCheckBox)
          { an individual radio button.  This class should not ordinarily be used directly. }
           { If it is, it will act just like a check box, and will just look different. }
            itsGroup: xRadioGroup;
            numInGroup: integer;
            procedure SetUp (win: xWindow;
                                        name: string;
                                        theLeft, theTop: integer);
            override;
            procedure doClick (localPt: point;
                                        modifiers: longint);
            override;
        end;


    xEmptyButton = object(xWindowDecoration)
         { the intent of this class is to provide something like an invisible button that }
         { can be placed over some existing graphics, such as an xIcon;  the button created }
         { in this way will act pretty much like an ordinary button and is used in the }
         { same way.  Since it is not really a control, it does not respond to all the methods }
         { defined for xControlDecorations. }
            procedure SetUp (win: xWindow;
                                        theLeft, theRight, theWidth, theHeight: integer);
         { creates the button and installs it in the window win; the remaining parameters }
         { have their usual meaning (see comment on xButton.SetUp) }
            procedure HandleClick;
         { This is called when the user clicks the button; to use a button, you will }
         { ordinarily create a sub-class and override this method. }
            procedure Press;
         { simulates a user press of the button, including briefly hiliting the button and }
         { calling procedure HandleClick }
            procedure doClick (localPt: point;
                                        modifiers: longint);
            override;
        end;

    xFramedEmptyButton = object(xEmptyButton)
       { identical to xEmptyButton, except a 1-pixel wide border is drawn around the button }
            procedure doDraw;
            override;
        end;


implementation

procedure xControlDecoration.makeInactive;
    begin
        if theControl <> nil then
            if not grayedOut then begin
                    grayedOut := true;
                    wantsClick := false;
                    HiliteControl(theControl, 255);
                end;
    end;

procedure xControlDecoration.makeActive;
    begin
        if theControl <> nil then
            if grayedOut then begin
                    grayedOut := false;
                    wantsClick := true;
                    if (itsWindow <> nil) & (itsWindow.theWindow <> nil) & (itsWindow.theWindow = FrontWindow) then
                        HiliteControl(theControl, 0);
                end;
    end;

procedure xControlDecoration.init;
    var
        crs: cursHandle;
    begin
        inherited init;
        theControl := nil;
        trueWidth := 1;
        trueHeight := 1;
        wantsClick := true;
        crs := GetCursor(129);
        if crs <> nil then
            useCursor(crs^^);
    end;

procedure xControlDecoration.kill;
    begin
        if theControl <> nil then
            disposeControl(theControl);
        inherited kill;
    end;

procedure xControlDecoration.doActivate (active: boolean);
    begin
        if theControl <> nil then
            if active then begin
                    if not grayedOut then
                        HiliteControl(theControl, 0);
                end
            else
                HiliteControl(theControl, 255);
    end;

procedure xControlDecoration.adjustSize;
    var
        savePort: GrafPtr;
    begin
        inherited adjustSize;
        if drawRect.right < drawRect.left + trueWidth then
            drawRect.right := drawRect.left + trueWidth;
        if drawRect.bottom < drawRect.top + trueHeight then
            drawRect.bottom := drawRect.top + trueHeight;
        if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
                GetPort(savePort);
                SetPort(itsWindow.theWindow);
                InvalRect(clickRect);
                InvalRect(drawRect);
                SetPort(savePort);
            end;
        clickRect := drawRect;
        if theControl <> nil then begin
                theControl^^.contrlRect := drawRect;
            end;
    end;

procedure xControlDecoration.show;
    begin
        inherited show;
        if theControl <> nil then
            ShowControl(theControl);
    end;

procedure xControlDecoration.hide;
    begin
        inherited hide;
        if theControl <> nil then
            HideControl(theControl);
    end;

    type
        stringList = array[1..10] of string;

procedure SubdivideName (var name: string;
                                var nameList: stringList;
                                var ct: integer;
                                Win: WindowPtr;
                                var width, height: integer);
    var
        savePort: GrafPTr;
        saveFont: integer;
        saveSize: integer;
        saveFace: style;
        i: integer;
        info: fontInfo;
    begin
        if length(name) = 0 then begin
                ct := 0;
                width := 0;
                height := 0;
                EXIT(SubdivideName);
            end;
        GetPort(savePort);
        SetPort(win);
        saveFont := win^.txFont;
        saveSize := win^.txSize;
        saveFace := win^.txFace;
        TextFont(systemFont);
        TextSize(12);
        TextFace([]);
        for i := 1 to 10 do
            nameList[i] := '';
        ct := 1;
        i := 1;
        while i <= length(name) do begin
                if name[i] = '\' then begin
                        name[i] := chr(13);
                        if ct = 10 then
                            i := length(name)
                        else
                            ct := ct + 1;
                    end
                else
                    nameList[ct] := Concat(nameList[ct], name[i]);
                i := i + 1;
            end;
        width := 0;
        for i := 1 to ct do
            if StringWidth(nameList[i]) > width then
                width := StringWidth(nameList[i]);
        GetFontInfo(info);
        height := ct * (info.ascent + info.descent + info.leading);
        TextFace(saveFace);
        TextFont(saveFont);
        TextSize(saveSize);
        SetPort(savePort);
    end;

procedure xButton.SetUp (win: xWindow;
                                name: string;
                                theLeft, theTop, theWidth, theHeight: integer);
    var
        dh, dv: integer;
        junkArray: stringList;
        junkCount: integer;
    begin
        init;
        if (win = nil) | (win.theWindow = nil) then
            EXIT(SetUp);
        SubDivideName(name, junkArray, junkCount, win.theWindow, dh, dv);
        trueWidth := dh + 20;
        trueHeight := dv + 4;
        install(win, theLeft, theTop, theWidth, theHeight);  { size will be adjusted }
        theControl := NewControl(win.theWindow, clickRect, name, true, 0, 0, 1, pushButProc, 0);
    end;

procedure xButton.HandleClick;
    begin
        Sysbeep(5);
    end;

procedure xButton.Press;
    var
        junk: longint;
    begin
        if (not grayedOut) & (itsWindow.theWindow <> nil) & (itsWindow.theWindow = FrontWindow) then begin
                HiliteControl(theControl, 1);
                Delay(7, junk);
                HiliteControl(theControl, 0);
            end;
        HandleClick;
    end;

procedure xButton.SetName (name: string);
    var
        junkArray: stringList;
        junkCount: integer;
        dh, dv: integer;
        changeSize: boolean;
    begin
        if (theControl = nil) | (itsWindow = nil) | (itsWindow.theWindow = nil) then
            EXIT(setName);
        SubDivideName(name, junkArray, junkCount, itsWindow.theWindow, dh, dv);
        changeSize := false;
        if (dh + 2 > drawRect.right - drawRect.left) then begin
                truewidth := dh + 20;
                changeSize := true;
            end;
        if (dv + 2 > drawRect.bottom - drawRect.top) then begin
                trueHeight := dv + 4;
                changeSize := true;
            end;
        if changeSize then
            adjustSize;
        SetCTitle(theControl, name);
    end;

procedure xButton.doClick (localPt: point;
                                modifiers: longint);
    begin
        if TrackControl(theControl, localPt, nil) <> 0 then
            HandleClick;
    end;

procedure xDefaultButton.init;
    begin
        inherited init;
        wantsCR := true;
    end;

procedure xDefaultButton.adjustSize;
    begin
        inherited adjustSize;
        InsetRect(drawRect, -4, -4);
    end;

procedure xDefaultButton.doCr (ch: char);
    begin
        press;
    end;

procedure xDefaultButton.doDraw;
    var
        saveSize: point;
    begin
        inherited doDraw;
        saveSize := itsWindow.theWindow^.pnSize;
        PenSize(3, 3);
        FrameRoundRect(drawRect, 24, 24);
        PenSize(saveSize.h, saveSize.v);
    end;

procedure xCheckBox.SetUp (win: xWindow;
                                name: string;
                                theLeft, theTop: integer);
    var
        dh, dv: integer;
        junkArray: stringList;
        junkCount: integer;
    begin
        init;
        if (win = nil) | (win.theWindow = nil) then
            EXIT(SetUp);
        SubDivideName(name, junkArray, junkCount, win.theWindow, dh, dv);
        trueWidth := dh + 20;
        trueHeight := dv;
        install(win, theLeft, theTop, trueWidth, trueHeight);
        theControl := NewControl(win.theWindow, clickRect, name, true, 0, 0, 1, checkBoxProc, 0);
    end;

procedure xCheckBox.check;
    begin
        if theControl <> nil then
            SetCtlValue(theControl, 1);
    end;

procedure xCheckBox.unCheck;
    begin
        if theControl <> nil then
            SetCtlValue(theControl, 0);
    end;

function xCheckBox.checked: boolean;
    begin
        if theControl <> nil then
            checked := (GetCtlValue(theControl) = 1);
    end;

procedure xCheckBox.HandleClick;
    begin
    end;

procedure xCheckBox.doClick (localPt: point;
                                modifiers: longint);
    begin
        if (theControl <> nil) & (TrackControl(theControl, localPt, nil) <> 0) then begin
                if checked then
                    uncheck
                else
                    check;
                HandleClick
            end;
    end;

procedure xRadioButton.SetUp (win: xWindow;
                                name: string;
                                theLeft, theTop: integer);
    var
        dh, dv: integer;
        junkArray: stringList;
        junkCount: integer;
    begin
        init;
        if (win = nil) | (win.theWindow = nil) then
            EXIT(SetUp);
        SubDivideName(name, junkArray, junkCount, win.theWindow, dh, dv);
        trueWidth := dh + 20;
        trueHeight := dv;
        install(win, theLeft, theTop, trueWidth, trueHeight);
        theControl := NewControl(win.theWindow, clickRect, name, true, 0, 0, 1, radioButProc, 0);
        itsGroup := nil;
    end;

procedure xRadioButton.doClick (localPt: point;
                                modifiers: longint);
    begin
        if (theControl <> nil) & (TrackControl(theControl, localPt, nil) <> 0) then begin
                if itsGroup <> nil then begin
                        if not checked then
                            itsGroup.select(numInGroup);
                    end
                else begin
                        if checked then
                            uncheck
                        else
                            check;
                        HandleClick
                    end;
            end;
    end;

procedure xRadioGroup.SetUp (win: xWindow;
                                name: string;
                                theLeft, theTop: integer);
    var
        nameList: stringList;
        nameCt: integer;
        dh, dv: integer;
        i: integer;
        rb: xRadioButton;
    begin
        if (win = nil) | (win.theWindow = nil) then
            EXIT(Setup);
        SubdivideName(name, nameList, nameCt, win.theWindow, dh, dv);
        if nameCt = 0 then
            EXIT(setUp);
        buttonCount := nameCt;
        dv := dv div buttonCount;
        for i := 1 to buttonCount do begin
                new(rb);
                rb.setUp(win, nameList[i], theLeft, theTop);
                rb.itsGroup := self;
                rb.numInGroup := i;
                theButtons[i] := rb;
                theTop := theTop + dv;
            end;
        selected := 1;
        theButtons[1].check
    end;

procedure xRadioGroup.select (buttonNum: integer);
    begin
        if (buttonNum > 0) & (buttonNum <= buttonCount) & (buttonNum <> selected) then begin
                theButtons[selected].uncheck;
                theButtons[buttonNum].check;
                selected := buttonNum;
                HandleChangeOfSelection
            end;
    end;

function xRadioGroup.selectedButton: integer;
    begin
        selectedButton := selected;
    end;

procedure xRadioGroup.HandleChangeOfSelection;
    begin
    end;

procedure xRadioGroup.hide;
    var
        i: integer;
    begin
        for i := 1 to buttonCount do
            theButtons[i].hide;
    end;

procedure xRadioGroup.show;
    var
        i: integer;
    begin
        for i := 1 to buttonCount do
            theButtons[i].show;
    end;

procedure xScrollBar.SetUp (win: xWindow;
                                theLeft, theTop, theWidth, theHeight: integer);
    begin
        init;
        if (win = nil) | (win.theWindow = nil) then
            EXIT(SetUp);
        trueWidth := 10;
        trueHeight := 10;
        linesPerPage := 1;
        grayedOut := false;
        savedMax := -1;
        install(win, theLeft, theTop, theWidth, theHeight);  { size will be adjusted }
        theControl := NewControl(win.theWindow, clickRect, '', true, 0, 0, 0, scrollBarProc, longint(self));
    end;

procedure xScrollBar.adjustSize;
    var
        w, h: integer;
        savePort: GrafPtr;
    begin
        if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
                if left < 0 then
                    drawRect.left := itsWindow.theWindow^.portRect.right + left
                else
                    drawRect.left := left;
                if top < 0 then
                    drawRect.top := itsWindow.theWindow^.portRect.bottom + top
                else
                    drawRect.top := top;
                if height <= 0 then
                    drawRect.bottom := itsWindow.theWindow^.portRect.bottom + height
                else
                    drawRect.bottom := drawRect.top + height;
                if width <= 0 then
                    drawRect.right := itsWindow.theWindow^.portRect.right + width
                else
                    drawRect.right := drawRect.left + width;
                if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
                        GetPort(savePort);
                        SetPort(itsWindow.theWindow);
                        InvalRect(clickRect);
                        InvalRect(drawRect);
                        SetPort(savePort);
                    end;
                clickRect := drawRect;
                w := clickRect.right - clickRect.left;
                h := clickRect.bottom - clickRect.top;
                if (w < 40) & (h < 40) then begin
                        if w > h then
                            w := 40
                        else
                            h := 40
                    end;
                if (w > h) then begin
                        if (h > w div 4) | (h < 10) then
                            h := w div 4
                    end
                else begin
                        if (w > h div 4) | (w < 10) then
                            w := h div 4
                    end;
                clickRect.right := clickRect.left + w;
                clickRect.bottom := clickRect.top + h;
                drawRect := clickRect;
                if theControl <> nil then begin
                        theControl^^.contrlRect := drawRect;
                    end;
            end;
    end;

procedure xScrollBar.SetMax (newMax: integer);
    begin
        if theControl <> nil then begin
                if savedMax >= 0 then
                    savedMax := newMax
                else begin
                        SetCtlMax(theControl, newMax);
                    end;
            end;
    end;

procedure xScrollBar.SetVal (newVal: integer);
    begin
        if theControl <> nil then
            if savedMax >= 0 then
                savedVal := newVal
            else
                SetCtlValue(theControl, newVal);
    end;

function xScrollBar.GetVal: integer;
    begin
        if theControl <> nil then
            GetVal := GetCtlValue(theControl);
    end;

function xScrollBar.GetMax: integer;
    begin
        if theControl <> nil then
            GetMax := GetCtlMax(theControl);
    end;

procedure xScrollBar.makeActive;
    begin
        if savedMax >= 0 then begin
                SetCtlMax(theControl, savedMax);
                SetCtlValue(theControl, savedVal);
                if savedMax > 0 then begin
                        grayedOut := false;
                        wantsClick := true;
                    end;
                savedMax := -1;
                if (itsWindow <> nil) & (itsWindow.theWindow <> nil) & (itsWindow.theWindow = FrontWindow) then
                    HiliteControl(theControl, 0);
            end;
    end;

procedure xScrollBar.makeInactive;
    begin
        if (theControl <> nil) & (savedMax = -1) then begin
                savedMax := GetCtlMax(theControl);
                savedVal := GetCtlValue(theControl);
                SetCtlMax(theControl, 0);
                grayedOut := true;
                wantsClick := false;
                HiliteControl(theControl, 255);
            end;
    end;

procedure xScrollBar.SetLinesPerPage (lines: integer);
    begin
        if lines < 1 then
            linesPerPage := 1
        else
            LinesPerPage := lines;
    end;

procedure xScrollBar.HandleScroll (changeInVal: integer);
    begin
    end;

procedure continuousScroll (ctl: ControlHandle;
                                partCode: integer);
    var
        dec: xScrollBar;
        lines: integer;
        val: integer;
        max: integer;
    begin
        val := getCtlValue(ctl);
        max := getCtlMax(ctl);
        dec := xScrollBar(ctl^^.ContrlRfCon);
        case partCode of
            inDownButton:
                lines := 1;
            inUpButton:
                lines := -1;
            inPageDown:
                lines := dec.LinesPerPage;
            inPageUp:
                lines := -dec.LinesPerPage;
            otherwise
                EXIT(ContinuousScroll);
        end;
        if val + lines < 0 then
            lines := -val
        else if val + lines > max then
            lines := max - val;
        if lines <> 0 then begin
                SetCtlValue(ctl, val + lines);
                dec.HandleScroll(lines)
            end;
    end;



procedure xScrollBar.doClick (localPt: point;
                                modifiers: longint);
    var
        part: integer;
        ctl: ControlHandle;
        oldVal: integer;
    begin
        part := FindControl(localPt, itsWindow.theWindow, ctl);
        if (part = 0) | (ctl <> theControl) then
            EXIT(doClick);
        if part in [inUpButton, inDownButton, inPageUp, inPageDown] then
            part := TrackControl(ctl, localPt, @continuousScroll)
        else if part = inThumb then begin
                oldVal := GetCtlValue(ctl);
                part := TrackControl(ctl, localPt, nil);
                if (part = inThumb) & (oldVal <> GetCtlValue(ctl)) then
                    HandleScroll(GetCtlValue(theControl) - oldVal)
            end;
    end;


procedure xEmptyButton.SetUp (win: xWindow;
                                theLeft, theRight, theWidth, theHeight: integer);
    var
        crs: CursHandle;
    begin
        init;
        wantsClick := true;
        crs := GetCursor(129);
        if crs <> nil then
            useCursor(crs^^);
        install(win, theLeft, theRight, theWidth, theHeight);
    end;

procedure xEmptyButton.HandleClick;
    begin
        SysBeep(5);
    end;

procedure xEmptyButton.Press;
    var
        junk: longint;
        savePort: GrafPtr;
    begin
        if (visible) & (itsWindow.theWindow <> nil) & (itsWindow.theWindow = FrontWindow) then begin
                GetPort(savePort);
                SetPort(itsWindow.theWindow);
                InvertRect(drawRect);
                Delay(7, junk);
                InvertRect(drawRect);
                SetPort(savePort);
            end;
        HandleClick;
    end;

procedure xEmptyButton.doClick (localPt: point;
                                modifiers: longint);
    var
        inside: boolean;
        pt: point;
    begin
        inside := false;
        while StillDown do begin
                GetMouse(pt);
                if PtInRect(pt, drawRect) then begin
                        if not inside then begin
                                inside := true;
                                InvertRect(drawRect);
                            end;
                    end
                else begin
                        if inside then begin
                                inside := false;
                                InvertRect(drawRect);
                            end;
                    end;
            end;
        if inside then begin
                InvertRect(drawRect);
                HandleClick;
            end;
    end;

procedure xFramedEmptyButton.doDraw;
    var
        savePen: point;
    begin
        savePen := itsWindow.theWindow^.pnSize;
        PenSize(1, 1);
        FrameRect(drawRect);
        PenSize(savePen.h, savePen.v);
    end;

end.